home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 1.iso / DEMON / LANGUAGE / POTSRC.ARC / src / mod / cocn < prev    next >
Text File  |  1995-05-06  |  5KB  |  150 lines
  1. MODULE COCN; (* DT 22 10 1993 00:03 *)
  2.   IMPORT SYSTEM, Strings, Reals, COCT, COCQ;
  3.  
  4.   CONST
  5.    (* name resolution modes *)
  6.     ordObj = 0; stdObj = 1; sysObj = 2;
  7.  
  8.    (*object and item modes*)
  9.     Var = 1; Ind =3; Con = 8; Fld = 12; Typ = 13; CProc = 17;
  10.  
  11.    (*structure forms*)    
  12.     Undef = 0; Bool = 2; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;    
  13.     Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;    
  14.  
  15.  (* name resolution and designating *)
  16.   PROCEDURE CObjBaseName*(VAR x: COCT.Item; pos: INTEGER; VAR nextpos: INTEGER);
  17.     VAR head: COCT.Object; 
  18.   BEGIN
  19.     nextpos := pos;
  20.     IF x.obj = NIL THEN RETURN END;
  21.         IF x.mode = CProc THEN
  22.             COCQ.Prepend(x.obj.name, nextpos, nextpos) (* directly called external C function *)
  23.         ELSE
  24.         COCQ.Prepend("pOt_", nextpos, nextpos);
  25.         COCQ.Prepend(x.obj.name, nextpos, nextpos);
  26.         IF x.mode # Fld THEN
  27.           IF x.mnolev < 0 THEN
  28.             COCQ.Prepend("_", nextpos, nextpos); 
  29.             COCQ.Prepend(COCT.GlbMod[-x.mnolev - 1].name, nextpos, nextpos)
  30.           ELSIF x.mnolev = 0 THEN
  31.             CASE x.obj.mnolev OF ordObj:
  32.               head := COCT.topScope;
  33.               WHILE head.mnolev # 0 DO head := head.dsc END;
  34.               COCQ.Prepend("_", nextpos, nextpos);
  35.               COCQ.Prepend(head.name, nextpos, nextpos)
  36.             | stdObj:
  37.             | sysObj: COCQ.Prepend("_SYSTEM", nextpos, nextpos)
  38.             END
  39.           ELSE
  40.             IF (x.mode >= Con) OR (x.mnolev < COCT.level) THEN
  41.               head := COCT.topScope;
  42.               WHILE x.mnolev # head.mnolev DO head := head.dsc END;
  43.               LOOP
  44.                 COCQ.Prepend("_", nextpos, nextpos); 
  45.                 COCQ.Prepend(head.name, nextpos, nextpos); 
  46.                 IF head.mnolev = 0 THEN EXIT  END;
  47.                 head := head.dsc
  48.               END
  49.             ELSIF x.mnolev > COCT.level THEN
  50.               COCQ.Prepend("_", nextpos, nextpos) (* twin *)
  51.             END
  52.           END
  53.             END
  54.     END
  55.   END CObjBaseName;
  56.  
  57.   PROCEDURE CObjName*(VAR x: COCT.Item; pos: INTEGER; VAR nextpos: INTEGER);
  58.     VAR viaref: BOOLEAN;
  59.   BEGIN nextpos := pos;
  60.     viaref := (x.mode = Var) & (x.mnolev > 0) & (x.mnolev # COCT.level);
  61.     IF viaref THEN COCQ.Prepend("(*", nextpos, nextpos) END;
  62.     CObjBaseName(x, nextpos, nextpos);
  63.     IF viaref THEN COCQ.Prepend(")", nextpos, nextpos) END
  64.   END CObjName;
  65.  
  66.   PROCEDURE CRetName*(pos: INTEGER; VAR nextpos: INTEGER);
  67.   BEGIN COCQ.Prepend("pOt__retval", pos, nextpos)
  68.   END CRetName;
  69.     
  70.   PROCEDURE CTDName*(typ: COCT.Struct; pos: INTEGER; VAR nextpos: INTEGER);
  71.     VAR
  72.       head: COCT.Object;
  73.       s: ARRAY 5 OF CHAR;
  74.   BEGIN (* provided typ.form = Record or typ.form = Array *)
  75.     nextpos := pos;
  76.     COCQ.Prepend("pOt__td_", nextpos, nextpos);
  77.     Strings.FromLInt(typ.descr, 16, s); COCQ.Prepend(s, nextpos, nextpos);
  78.     COCQ.Prepend("_", nextpos, nextpos);
  79.     IF typ.mno = 0 THEN 
  80.       head := COCT.topScope;
  81.       WHILE head.mnolev # 0 DO head := head.dsc END;
  82.       COCQ.Prepend(head.name, nextpos, nextpos)
  83.     ELSE COCQ.Prepend(COCT.GlbMod[typ.mno - 1].name, nextpos, nextpos)
  84.     END
  85.   END CTDName;
  86.  
  87.   PROCEDURE CTagName*(typ: COCT.Struct; pos: INTEGER; VAR nextpos: INTEGER);
  88.     VAR
  89.       head: COCT.Object;
  90.       s: ARRAY 5 OF CHAR;
  91.   BEGIN (* provided typ.form = Record or typ.form = Array *)
  92.     nextpos := pos;
  93.     COCQ.Prepend("struct pOt__tag_", nextpos, nextpos); (* each record has a symbolic tag *)
  94.     Strings.FromLInt(typ.descr, 16, s); COCQ.Prepend(s, nextpos, nextpos);
  95.     COCQ.Prepend("_", nextpos, nextpos);
  96.     IF typ.mno = 0 THEN 
  97.       head := COCT.topScope;
  98.       WHILE head.mnolev # 0 DO head := head.dsc END;
  99.       COCQ.Prepend(head.name, nextpos, nextpos)
  100.     ELSE COCQ.Prepend(COCT.GlbMod[typ.mno - 1].name, nextpos, nextpos)
  101.     END
  102.   END CTagName;
  103.  
  104.   PROCEDURE CTDenoter*(typ: COCT.Struct; pos: INTEGER; VAR nextpos: INTEGER);
  105.     VAR y: COCT.Item;
  106.     
  107.   BEGIN
  108.     nextpos := pos;
  109.     CASE typ.form OF Undef:
  110.     | Bool .. Set: 
  111.       y.mode := Typ; y.typ := typ; y.obj := typ.strobj;
  112.       IF typ.mno > 0 THEN y.mnolev := -typ.mno
  113.       ELSE COCT.FindObj(y.obj, y.mnolev)
  114.       END;
  115.       CObjName(y, nextpos, nextpos)
  116.     | String .. NilTyp: 
  117.         | NoTyp: COCQ.Prepend("void", nextpos, nextpos)
  118.     | Pointer: CTDenoter(typ.BaseTyp, nextpos, nextpos); COCQ.Prepend("*",nextpos,nextpos)  
  119.     | ProcTyp: CTDenoter(typ.BaseTyp, nextpos, nextpos); COCQ.Prepend("(*)()",nextpos,nextpos)
  120.     | DynArr: COCQ.Prepend("pOt__ArrTypDsc**", nextpos, nextpos)
  121.     | Array, Record: CTagName(typ, nextpos, nextpos)
  122.     END
  123.   END CTDenoter;
  124.  
  125.   PROCEDURE CTSize*(typ: COCT.Struct; pos: INTEGER; VAR nextpos: INTEGER);
  126.     VAR y: COCT.Item;
  127.   BEGIN 
  128.     COCQ.Prepend("sizeof(", pos, nextpos); 
  129.     CTDenoter(typ, nextpos, nextpos);
  130.     COCQ.Prepend(")", nextpos, nextpos)  
  131.   END CTSize;
  132.  
  133.   PROCEDURE CBodyName*(obj: COCT.Object; pos: INTEGER; VAR nextpos: INTEGER);
  134.   BEGIN COCQ.Prepend("pOt_", pos, nextpos); 
  135.     IF obj.mnolev = 0 THEN COCQ.Prepend(obj.name, nextpos, nextpos)
  136.     ELSE COCQ.Prepend(COCT.GlbMod[obj.mnolev-1].name, nextpos, nextpos)
  137.     END;
  138.     COCQ.Prepend("__body", nextpos, nextpos)
  139.   END CBodyName;  
  140.  
  141.   PROCEDURE CBodyFlagName*(obj: COCT.Object; pos: INTEGER; VAR nextpos: INTEGER);
  142.   BEGIN COCQ.Prepend("pOt_", pos, nextpos); 
  143.     IF obj.mnolev = 0 THEN COCQ.Prepend(obj.name, nextpos, nextpos)
  144.     ELSE COCQ.Prepend(COCT.GlbMod[obj.mnolev-1].name, nextpos, nextpos)
  145.     END;
  146.     COCQ.Prepend("__loaded", nextpos, nextpos)
  147.   END CBodyFlagName;
  148.   
  149. END COCN.
  150.